SpotifyTop2018_40_V2.csv, que contiene una lista de 40 de las canciones más reproducidas en Spotify en el año 2018. Los datos incluyen una serie de características importantes del audio de cada canción.datos <- read.table("../datos/SpotifyTop2018_40_V2.csv", sep = ",", dec = ".", header = T)
str(datos)'data.frame': 40 obs. of 11 variables:
$ danceability : num 0.791 0.876 0.52 0.737 0.791 0.489 0.841 0.748 0.684 0.589 ...
$ energy : num 0.848 0.519 0.761 0.636 0.745 0.598 0.798 0.749 0.619 0.731 ...
$ loudness : num -3.46 -6.53 -3.09 -4.55 -3.69 ...
$ speechiness : num 0.0506 0.143 0.0853 0.0437 0.0464 0.036 0.229 0.516 0.0386 0.0868 ...
$ acousticness : num 0.183 0.202 0.256 0.0441 0.354 0.218 0.153 0.142 0.0716 0.0534 ...
$ instrumentalness: num 0.00 0.00 4.96e-06 6.66e-05 2.93e-05 0.00 3.33e-06 0.00 0.00 0.00 ...
$ liveness : num 0.409 0.108 0.17 0.35 0.104 0.35 0.0618 0.0713 0.122 0.308 ...
$ valence : num 0.828 0.158 0.286 0.565 0.82 0.172 0.591 0.659 0.284 0.191 ...
$ tempo : num 95 95 142 105 94 ...
$ duration_ms : int 200480 175230 180823 222653 188560 228373 212500 221013 217440 268867 ...
$ time_signature : int 4 4 4 4 4 3 4 4 4 4 ...
danceability energy loudness speechiness
Min. :0.2580 Min. :0.3910 Min. :-9.211 Min. :0.02320
1st Qu.:0.6805 1st Qu.:0.5643 1st Qu.:-7.077 1st Qu.:0.04955
Median :0.7500 Median :0.6590 Median :-5.930 Median :0.10550
Mean :0.7192 Mean :0.6619 Mean :-5.846 Mean :0.12129
3rd Qu.:0.8175 3rd Qu.:0.7725 3rd Qu.:-4.624 3rd Qu.:0.14450
Max. :0.9220 Max. :0.9090 Max. :-3.093 Max. :0.51600
acousticness instrumentalness liveness valence
Min. :0.000282 Min. :0.000e+00 Min. :0.02150 Min. :0.0967
1st Qu.:0.030800 1st Qu.:0.000e+00 1st Qu.:0.09527 1st Qu.:0.2875
Median :0.121500 Median :3.220e-06 Median :0.11200 Median :0.4375
Mean :0.184621 Mean :3.695e-03 Mean :0.17713 Mean :0.4679
3rd Qu.:0.227500 3rd Qu.:4.325e-05 3rd Qu.:0.29475 3rd Qu.:0.6332
Max. :0.847000 Max. :1.340e-01 Max. :0.55200 Max. :0.9310
tempo duration_ms time_signature
Min. : 77.17 Min. : 95467 3: 2
1st Qu.: 95.04 1st Qu.:189856 4:38
Median :122.53 Median :212904
Mean :122.11 Mean :205646
3rd Qu.:140.59 3rd Qu.:226983
Max. :191.70 Max. :268867
Para la variable dduration_ms se tiene que el máximo que dura una canción en miliseg es 268867 y el mínimo es 95467, además en promedio duran 205446.
Para la variable dtime_signature hay máximo 4 beats por medida y minimo 3 beats, en promedio hay 4 beats por barra
Hay dos 3 canciones que se parecen bastante entre el 0.7 y 0.8 eje x. Otras dos ubicadas cerca de 0.5 en el eje x.
En la variable
duration hay 3 datos atipicos entre 5000 y 15000.
R e interpréte dos de las correlaciones. Debe ser una interpretación dirigida a una persona que no sabe nada de estadística.library(corrplot)
matriz.correlacion<-cor(datos[,-11])
col <- colorRampPalette(c("#BB4444", "#EE9988", "#FFFFFF", "#77AADD", "#4477AA"))
corrplot(matriz.correlacion, method="shade", shade.col=NA, tl.col="black", tl.srt=45,
col=col(200), addCoef.col="black", order="AOE")La correlación positiva más alta es la de loudness y energy esto quiere decir que entre más intesidad y actividad haya en una canción esto también la hara más apta para bailar. Por otro lado la correlación negativa más alta es la de duration_ms y danceability de 0.31 no es muy alta pero si significativa, esto nos indica que una canción entre más bailable menor es su duración en milisegundos.
Elimine de los gráficos individuos y variables con menos del 5% de calidad de representación.
Explique la formación de los clústeres basado en la sobre-posición del círculo y el plano.
En el círculo de correlación determine la correlación entre las variables.
En el plano de los componentes 1 y 3 interprete las canciones In My Feelings, In My Mind, Havana, Candy Paint y HUMBLE, que son mal representadas en los componentes 1 y 2.
library("FactoMineR")
library("factoextra")
res<-PCA(datos[,-11], scale.unit=TRUE, ncp=5, graph = FALSE)
cos2.ind<-(res$ind$cos2[,1]+res$ind$cos2[,2])*100
plot(res, axes=c(1, 2), choix="ind",col.ind="red",new.plot=TRUE,select="cos2 0.05")# Valores de los gráficos por defecto
mi.tema <- theme_grey() + theme(panel.border = element_rect(fill = NA,color = "black"), plot.title = element_text(hjust = 0.5))
fviz_pca_var(res,col.var="steelblue", select.var = list(cos2 = 0.05),ggtheme = mi.tema)Para ubicarnos mejor usaremos los cuadrantes, el primero se ubican las canciones con mayor duración, tempo, música en vivo e instrumentalidad, el segundo cuadrante hay canciones con más loudnes y energy, el tercer cuadrante tiene las canciones con menos bulla y energía pero más presencia de palabras y acústica. El cuarto cuadrante y más bailables y con más positividad pero menos duración y tempo.
SAheart.csv la cual contiene variables numéricas y categóricas mezcladas. La descripción de los datos es la siguiente:Datos Tomados del libro: The Elements of Statistical Learning Data Mining, Inference, and Prediction de Trevor Hastie, Robert Tibshirani y Jerome Friedman de la Universidad de Stanford. .Example: South African Heart Disease: A retrospective sample of males in a heart-disease high-risk region of the Western Cape, South Africa. There are roughly two controls per case of coronary heart disease. Many of the coronary heart disease positive men have undergone blood pressure reduction treatment and other programs to reduce their risk factors after their coronary heart disease event. In some cases the measurements were made after these treatments.
These data are taken from a larger dataset, described in Rousseauw et al, 1983, South African Medical Journal. Below is a description of the variables:
Las dos variables categóricas se explican como sigue: famhist significa que hay historia familiar de infarto y que la variable chd significa que la persona murió de enfermedad cardíaca coronaria.
Realice lo siguiente:
'data.frame': 462 obs. of 10 variables:
$ sbp : int 160 144 118 170 134 132 142 114 114 132 ...
$ tobacco : num 12 0.01 0.08 7.5 13.6 6.2 4.05 4.08 0 0 ...
$ ldl : num 5.73 4.41 3.48 6.41 3.5 6.47 3.38 4.59 3.83 5.8 ...
$ adiposity: num 23.1 28.6 32.3 38 27.8 ...
$ famhist : chr "Present" "Absent" "Present" "Present" ...
$ typea : int 49 55 52 51 60 62 59 62 49 69 ...
$ obesity : num 25.3 28.9 29.1 32 26 ...
$ alcohol : num 97.2 2.06 3.81 24.26 57.34 ...
$ age : int 52 63 46 58 49 45 38 58 29 53 ...
$ chd : chr "Si" "Si" "No" "Si" ...
En el plano principal encuentre los clústeres.
En el círculo de correlación determine la correlación entre las variables.
Explique la formación de los clústeres basado en la sobre-posición del círculo y el plano.
library("FactoMineR")
library("factoextra")
res<-PCA(datos[,-c(5,10)], scale.unit=TRUE, ncp=5, graph = FALSE)
plot(res, axes=c(1, 2), choix="ind",col.ind="red",new.plot=TRUE,select="cos2 0.05")Se observan 4 clusters (uno en cada cuadrante)
Las variables alcohol, tobacco, sbp, edad se correlacionan de forma positiva también de manera negativa con typea. Además las variables adiposity, ldl y obesidad se correlacionan de forma positiva entre ellas.
El primer cluster presenta los individuos que tienen bajos indices de obesidad, ldl y adiposidad, el segundo cluster individuos con altos niveles de alcohol, tabaco, sbp y obesidad, el tercero es lo contrario, los individuos con bajos niveles de lo anterior pero presentan más personalidad typea y finalmente el cuarto cluster individuos con alta adiposidad, obesidad y ldl.
En el plano principal encuentre los clústeres.
En el círculo de correlación determine la correlación entre las variables.
Explique la formación de los clústeres basado en la sobre-posición del círculo y el plano.
Explique las diferencias de este ACP respecto al anterior (usando solo las variables numéricas. ¿Cuál le parece más interesante? ¿Por qué?
famhist.Present <- as.numeric(datos$famhist == "Present")
famhist.Absent <- as.numeric(datos$famhist == "Absent")
chd.Si <- as.numeric(datos$chd == "Si")
chd.No <- as.numeric(datos$chd == "No")
datos2<-datos[,-c(5,10)]
datos2<-cbind(datos2,famhist.Present)
datos2<-cbind(datos2,famhist.Absent)
datos2<-cbind(datos2,chd.Si)
datos2<-cbind(datos2,chd.No)res<-PCA(datos2, scale.unit=TRUE, ncp=5, graph = FALSE)
plot(res, axes=c(1, 2), choix="ind", col.ind="red",new.plot=TRUE)Aqui se aprecian de mejor forma tres clusteres.
Aquí se observa que las variables famhist.Absent y chd.No se correlacion de forma positiva entre ellas y de forma negativa con typeA, chd.Si y famhist.Present. Ahora las variables tabaco, alcohol, edad y sbp , ldl y obesidad se correlacionan de forma positiva en este nuevo gráfico.
En el primer cluster se observan se observan los individuos con diagnóstico negativo e historial familiar ausente, el segundo con presencia de vicios y edad avanzada y el tercer cluster que se correlaciona de forma positiva con las variable anteriores pero menos intenso es el que presenta diagnóstico positivo, personalidad typea e historial familiar presente.
DeudaCredito.csv que contiene información de los clientes en una de las principales carteras de crédito del banco, e incluye variables que describen cada cliente tanto dentro del banco como fuera de este.Cargue la tabla de datos en R, asegúrese que las variables se están leyendo de forma correcta. Recodifique variables en caso de que sea necesario, tome para entrenamiento un 80% de la tabla de datos. Realice lo siguiente:
library(fastDummies)
datos <- read.table("../datos/DeudaCredito.csv", dec = ".", sep = ",", header = T, row.names = 1)
datos <- dummy_cols(datos, select_columns = c("Genero","Estudiante","Casado","Etnicidad"),remove_selected_columns = T)
numero.predictoras <- dim(datos)[2] - 1
filas <- dim(datos)[1]
muestra <- sample(1:filas, floor(filas*0.20))
ttesting <- datos[muestra,]
taprendizaje <- datos[-muestra,]# Residual Sum of Square (RSS)
RSS <- function(Pred,Real) {
ss <- sum((Real-Pred)^2)
return(ss)
}
# NumPred es el número total de predictores por eso se resta 1 (que es realidad sumar 1)
RSE<-function(Pred,Real,NumPred) {
N<-length(Real)-NumPred-1 # <- length(Real)-(NumPred+1)
ss<-sqrt((1/N)*RSS(Pred,Real))
return(ss)
}
MSE <- function(Pred,Real) {
N<-length(Real)
ss<-(1/N)*RSS(Pred,Real)
return(ss)
}
error.relativo <- function(Pred,Real) {
ss<-sum(abs(Real-Pred))/sum(abs(Real))
return(ss)
}
# Funciones para desplegar precisión
indices.precision <- function(real, prediccion,cantidad.variables.predictoras) {
return(list(error.cuadratico = MSE(prediccion,real),
raiz.error.cuadratico = RSE(prediccion,real,cantidad.variables.predictoras),
error.relativo = error.relativo(prediccion,real),
correlacion = as.numeric(cor(prediccion,real))))
}
# Gráfico de dispersión entre el valor real de la variable a predecir y la predicción del modelo.
plot.real.prediccion <- function(real, prediccion, modelo = "") {
g <- ggplot(data = data.frame(Real = real, Prediccion = as.numeric(prediccion)), mapping = aes(x = Real, y = Prediccion)) +
geom_point(size = 1, col = "dodgerblue3") +
labs(title = paste0("Real vs Predicción", ifelse(modelo == "", "", paste(", con", modelo))),
x = "Real",
y = "Predicción")
return(g)
}library(pls)
modelo.pcr <- pcr(Balance~., data = taprendizaje, scale = TRUE, validation = "CV")
# Selección automática y manual de la cantidad de componentes a usar según RMSE
# Automática
RMSE.CV <- RMSEP(modelo.pcr)$val[1, 1, ]
componentes.usados <- which.min(RMSE.CV) - 1 # RMSE.CV considera 0 componentes principales, por eso se resta 1.
componentes.usados10 comps
10
# Predicción
prediccion <- predict(modelo.pcr, ttesting, ncomp = componentes.usados)
# Medición de precisión
numero.predictoras <- dim(datos)[2]-1
pre.pcr <- indices.precision(ttesting$Balance, prediccion,numero.predictoras)
pre.pcr$error.cuadratico
[1] 10095.75
$raiz.error.cuadratico
[1] 112.3374
$error.relativo
[1] 0.1472242
$correlacion
[1] 0.9770373
Se utilizan 11 componentes. Según las medidas de error la correlación del modelo es 96.91% bastante alto, el porcentaje de error fue de 18% y en promedio el error fue de 124.07.
modelo.plsr <- plsr(Balance~., data = taprendizaje, scale = TRUE, validation = "CV")
# Selección automática y manual de la cantidad de componentes a usar según RMSE
# Automática
RMSE.CV <- RMSEP(modelo.plsr)$val[1, 1, ]
componentes.usados <- which.min(RMSE.CV) - 1 # RMSE.CV considera 0 componentes principales, por eso se resta 1.
componentes.usados7 comps
7
# Predicción
prediccion <- predict(modelo.plsr, ttesting, ncomp = componentes.usados)
# Medición de precisión
numero.predictoras <- dim(datos)[2]-1
pre.plsr <- indices.precision(ttesting$Balance, prediccion,numero.predictoras)
pre.plsr$error.cuadratico
[1] 10095.88
$raiz.error.cuadratico
[1] 112.3381
$error.relativo
[1] 0.1472337
$correlacion
[1] 0.9770351
Utiliza 13 componentes. Según las medidas de error la correlación del modelo es 96.87% más alto, el porcentaje de error fue de 18% y en promedio el error fue de 129.
Método ACP: No supervisado, utilizan el supuesto de que los componentes que explican mayor varianza en los predictores, son los que explican mayor varianza en Y.
Minimos Cuadrados Parciales: Supervisado, solucionan el problema con el supuesto ACP pues Es decir, los componentes ayudan a explicar la varianza de \(X_1, ...,X_p\), y la de \(Y\) a la vez.
En este caso ACP utiliza menos componentes, el método más eficiente y el que dio mejores resultados en testing fue MCP.
modelo.pcr <- pcr(Balance~., data = taprendizaje, scale = TRUE, validation = "CV")
# Selección automática y manual de la cantidad de componentes a usar según RMSE
# Automática
RMSE.CV <- RMSEP(modelo.pcr)$val[1, 1, ]
RMSE.CV(Intercept) 1 comps 2 comps 3 comps 4 comps 5 comps
457.6536 306.0926 274.5681 274.6228 273.0085 272.7803
6 comps 7 comps 8 comps 9 comps 10 comps 11 comps
273.4972 272.4380 274.0683 264.7629 100.9994 100.9801
12 comps 13 comps 14 comps 15 comps
100.9415 101.0647 101.0825 101.9963
# Gráfico de varianza explicada en los predictores según componentes usados
var.explicada <- cumsum(explvar(modelo.plsr)) / 100
var.explicada Comp 1 Comp 2 Comp 3 Comp 4 Comp 5 Comp 6 Comp 7 Comp 8
0.1805417 0.2738885 0.3551813 0.4227120 0.5300826 0.6224990 0.7136647 0.8004200
Comp 9 Comp 10 Comp 11 Comp 12 Comp 13 Comp 14 Comp 15
0.8527452 0.9320106 1.0000000 1.0301154 1.0601813 1.0903459 1.1206220
componentes.usados <- 3 # RMSE.CV considera 0 componentes principales, por eso se resta 1.
componentes.usados[1] 3
# Predicción
prediccion <- predict(modelo.pcr, ttesting, ncomp = componentes.usados)
# Medición de precisión
numero.predictoras <- dim(datos)[2]-1
pre.pcr <- indices.precision(ttesting$Balance, prediccion,numero.predictoras)
pre.pcr$error.cuadratico
[1] 86309.68
$raiz.error.cuadratico
[1] 328.4617
$error.relativo
[1] 0.4513619
$correlacion
[1] 0.7870872
Utilice 3 componentes ya que era el disminuía más la varianza y tenía un RMSE menor en comparación a los demás. Sin embargo no mejoraron las predicciones.
Es similar en el sentido de que hace selección de variables basado en cual minimiza el error, RSS en el caso de LASSO y RMSE en los de ACP. Sin embargo LASSO penaliza variables (las anula) y en estos metodos se les quita peso a las dimensiones encontradas por el ACP.
Aunque MCP dio mejores resultados, ACP solo dio peor en un 1% y este ultiza dos componentes menos, lo cual mejora su interpretabilidad. Se utilizan 11 componentes. Según las medidas de error la correlación del modelo es 97.96% bastante alto, el porcentaje de error fue de 16% y en promedio el error fue de 112.04.
AsientosNinno.csv que contiene detalles de ventas de asientos de niños para auto en una serie de tiendas similares a las del cliente, y además los datos incluyen variables que definen características de la tienda y su localidad. La tabla de datos está formada por 400 filas y 13 columnas. Seguidamente se explican las variables que conforman la tabla.Cargue la tabla de datos en R y no elimine los NA. En caso de ser necesario, recodificar las variables de forma adecuada. Para medir el error tome un 20 % de la tabla de datos. Realice lo siguiente:
datos <- read.table("../datos/AsientosNinno.csv", dec = ".", sep = ";",header = T, stringsAsFactors = T)[,-1]
datos$CalidadEstant <- factor(datos$CalidadEstant,levels = c("Malo","Medio","Bueno"), ordered=TRUE)
str(datos)'data.frame': 400 obs. of 13 variables:
$ Ventas : num 9.5 11.22 10.06 7.4 4.15 ...
$ PrecioCompt : int 138 111 113 117 141 124 115 136 132 132 ...
$ Ingreso : int 73 48 35 100 64 113 105 81 110 113 ...
$ CercaniaEsc : num 0.635 0.7 0.518 1.032 0.623 ...
$ Publicidad : int 11 16 10 4 3 13 0 15 0 0 ...
$ Poblacion : int 276 260 269 466 340 501 45 425 108 131 ...
$ Precio : int 120 83 80 97 128 72 108 120 124 124 ...
$ CalidadEstant: Ord.factor w/ 3 levels "Malo"<"Medio"<..: 1 3 2 2 1 1 2 3 2 2 ...
$ Edad : int 42 65 59 55 38 78 71 67 76 76 ...
$ Educacion : int 17 10 12 14 13 16 15 10 10 17 ...
$ Urbano : int 1 1 1 1 1 0 1 1 0 0 ...
$ USA : int 1 1 1 1 0 1 0 1 0 1 ...
$ Desarrollo : num 1.074 0.101 0.335 0.491 0.319 ...
datos <- dummy_cols(datos, select_columns = c("CalidadEstant"),remove_selected_columns = T)
numero.predictoras <- dim(datos)[2] - 1
filas <- dim(datos)[1]
muestra <- sample(1:filas, floor(filas*0.20))
ttesting <- datos[muestra,]
taprendizaje <- datos[-muestra,]
#elimino las variables
taprendizaje <- taprendizaje[,-c(4,13)]
ttesting <- ttesting[,-c(4,13)]library(pls)
modelo.pcr <- pcr(Ventas~., data = taprendizaje, scale = TRUE, validation = "CV")
# Selección automática y manual de la cantidad de componentes a usar según RMSE
# Automática
RMSE.CV <- RMSEP(modelo.pcr)$val[1, 1, ]
componentes.usados <- which.min(RMSE.CV) - 1 # RMSE.CV considera 0 componentes principales, por eso se resta 1.
componentes.usados11 comps
11
# Predicción
prediccion <- predict(modelo.pcr, ttesting, ncomp = componentes.usados)
# Medición de precisión
numero.predictoras <- dim(datos)[2]-1
pre.pcr <- indices.precision(ttesting$Ventas, prediccion,numero.predictoras)
pre.pcr$error.cuadratico
[1] 0.6663612
$raiz.error.cuadratico
[1] 0.9056141
$error.relativo
[1] 0.08374512
$correlacion
[1] 0.9594843
modelo.plsr <- plsr(Ventas~., data = ttesting, scale = TRUE, validation = "CV")
# Selección automática y manual de la cantidad de componentes a usar según RMSE
# Automática
RMSE.CV <- RMSEP(modelo.plsr)$val[1, 1, ]
componentes.usados <- which.min(RMSE.CV) - 1 # RMSE.CV considera 0 componentes principales, por eso se resta 1.
componentes.usados10 comps
10
# Predicción
prediccion <- predict(modelo.plsr, ttesting, ncomp = componentes.usados)
# Medición de precisión
numero.predictoras <- dim(datos)[2]-1
pre.plsr <- indices.precision(ttesting$Ventas, prediccion,numero.predictoras)
pre.plsr$error.cuadratico
[1] 0.5562593
$raiz.error.cuadratico
[1] 0.8274218
$error.relativo
[1] 0.07782206
$correlacion
[1] 0.9660308
library(dplyr)
errores <- rbind(as.data.frame(pre.pcr),as.data.frame(pre.plsr))
rownames(errores) <- c("Regresión ACP"," Regresión MCP")
erroresTomando como referencia el error cuadrático medio, el mejor modelo fue SVM con núcleo linear de la Tarea 5.
El promedio de los errores fue 0.87.
La correlación fue de 97.83% la cual es bastante alta, incluso más alta que con el modelo de Regresión Múltiple de la tarea antes que fue de 97.12%.
En promedio el modelo se equivocó en un 10%
Soluciones en Pdf